;;;   -*-LISP-*-
;;;   **************************************************************
;;;   ***** Maclisp ****** CCLOAD - Loader for COMPLR **************
;;;   **************************************************************
;;;   ** (c) Copyright 1978 Massachusetts Institute of Technology **
;;;   ****** this is a read-only file! (all writes reserved) *******
;;;   **************************************************************

(COMMENT CORE 80. BPS 58000.)

;This will compose a MACLISP compiler from the following files:
;	   LISP;  LET    FASL		(LET.FAS on TOPS-10 systems)
;	   LISP;  BACKQ  FASL		(BACKQ.FAS on TOPS-10 systems)
;	   LISP;  GETMID FASL		(GETMID.FAS on TOPS-10 systems)
;          COMLAP;COMPLR FASL		(COMPLR.FAS on TOPS-10 systems)
;		  FASLAP FASL		(FASLAP.FAS on TOPS-10 systems)
;	   [	 663CF FASL]		;assuming COMPLR version 663
;	   [	 263FF FASL]		;assuming FASLAP version 223
;Additionally, a gc-daemon and many other help files are loaded in the
;  SAIL version.
;Ordinarily, this file will be used as an "INIT" file, but it can be
;  directly loaded into a running lisp, using any of LOAD, or UREAD.

;It will ask a question regarding "PURE" and the answer means
;	<SPACE> or "1", 	use 1 UUOLINK page [in new scheme, merely
;				    equivalent to (SSTATUS UUOLI)]
;	T			pure load, but no UUOLINKS
;	() 			regular FASLOAD
;	LAP 			use COMPLR LAP, and ask again whether
;					FASLAP is wanted
;	XC			(SSTATUS FEATURE XC), use 1 UUOLINK 
;					page - experimental compiler
;Ordinarily the result will be :PDUMPI'd (by SUSPEND) as 
;   COMLAP;CL.DMP <complrverno>  [there is a link on SYS for TS COMPLR
;				to COMLAP;CL.DMP >]
;However, if there is no UUOLINKS page, or the compiler is experimental, 
; they will go out on JONL directory.  Thus there is a link for XCOMPLR to
; JONL;XC.DMP >

;;; Following code must come before everything else, so that only the 
;;;   important symbols get on the copy of the initial OBARRAY.
;;;   PURCOPYs the buckets of the initial OBARRAY copy.


((LAMBDA (N READTABLE) 
	 (COND ((OR (NOT (STATUS MACRO /,))
		    (NOT (GET '+INTERNAL-COMMA-FUN 'SUBR)))
		(PUTPROP '+INTERNAL-COMMA-FUN 
			 (GET '+INTERNAL-BACKQUOTE-MACRO 'AUTOLOAD)
			 'AUTOLOAD)
		(SETSYNTAX '/, 'MACRO '+INTERNAL-COMMA-FUN)))
	 (AND (STATUS FEATURE SAIL) 
	      (PROG2 (FASLOAD (DSK (MAC LSP)) MATCH FAS)
		     (FASLOAD (DSK (MAC LSP)) STRING FAS)))
	 (SETQ IREADTABLE READTABLE)
	 (SETQ IOBARRAY (ARRAY () OBARRAY '() ))	;Make pure copy of 
	 (DO I 0 (1+ I) (= I N) 			; original obarray
	     (STORE (ARRAYCALL T IOBARRAY I) (PURCOPY (OBARRAY I))))
	 '*)
 (- (CADR (ARRAYDIMS 'OBARRAY)) 129.)
 (ARRAY () READTABLE 'T))


(PROGN 
  (SETQ *RSET () NOUUO () NORET 'T )
  (SETQ CCLOAD:PUTPROP PUTPROP CCLOAD:PURE PURE)
  (PROG (GL LVRL FLPDL TIME RUNTIME PUTPROP PURE
	 ALARMCLOCK SLOTX REGACS NUMACS MODELIST FASLOAD 
	 UNSFLST FXPDL REGPDL NLNVTHTBP *PURE  
	 CCLOAD:CLOCK-SLOWDOWN CCLOAD:CLOCK-INTERVAL CCLOAD:CLOCK-EPSILON 
	 CCLOAD:TIME-TEMP CCLOAD:OTIME-TEMP CCLOAD:FLUSH-TTY CCLOAD:DEV-DIR  
	 )
	(SETQ RUNTIME (RUNTIME) TIME (TIME) FXPDL (STATUS FEATURE NOLDMSG)
	      *PURE 'T PURE CCLOAD:PURE 
	      PUTPROP (APPEND '(STATUS SSTATUS INST INSTN IMMED CARCDR NUMBERP 
				ARITHP NOTNUMP CONTAGIOUS COMMU ACS CONV MINUS 
				BOTH FLOATI P1BOOL1ABLE FUNTYP-INFO ARGS) 
			      CCLOAD:PUTPROP))
	(ALLOC '(FIXNUM (2048. 10240. .25) FLONUM (256. 4096. .10) 
		 BIGNUM (256. 4096. .10) SYMBOL (1536. 8192. .25) 
		 ARRAY (64. 1024. 64.) ))
	(AND (STATUS FEATURE ITS) (ALLOC '(LIST (14336. 40960. .35))))
	(SSTATUS FEATURE NOLDMSG)
	(SETQ CCLOAD:CLOCK-EPSILON 3.0 FLPDL 'T)
	(SETQ NUMACS '(LAMBDA () 			;TURNS ALARM OFF
			(ALARMCLOCK 'TIME -1)
			((LAMBDA (↑W ↑R) (PRINC '|/
Clock-OFF | TYO)) () () )
			(SETQ ALARMCLOCK () ↑W 'T CCLOAD:FLUSH-TTY 'T 
			      SLOTX REGACS))
	      REGACS '(LAMBDA () 			;TURNS ALARM ON
			(SETQ ALARMCLOCK MODELIST ↑W () SLOTX NUMACS  
			      CCLOAD:FLUSH-TTY () CCLOAD:CLOCK-SLOWDOWN 40.0 
			      CCLOAD:CLOCK-INTERVAL 10.) 
			((LAMBDA (↑W ↑R) (PRINC '|/
Clock-ON | TYO)) () () )
			(ALARMCLOCK 'TIME 1.))) 
	(COMMENT 
		;SLOTX holds either NUMACS or REGACS, to hac the ALARMCLOCK
		;	(NUMACS) turns ALARMCLOCK feature on
		;	(REGACS) turns it off
		;RUNTIME is the RUNTIME before beginning
		;TIME is the realTIME before beginning
		;CCLOAD:CLOCK-INTERVAL is the interval between alarm rings, 
		;CCLOAD:CLOCK-EPSILON is the epsilonics - two tics within a 
		;    realtime of less than CCLOAD:CLOCK-EPSILON cause the 
		;    second to be ignored.
		;CCLOAD:CLOCK-SLOWDOWN is the time at which the interval should
		;     be slowed, [i.e., doubled] we want alarms less often as 
		;     time goes by 
		;CCLOAD:TIME-TEMP is a temporary time holder
		;CCLOAD:FLUSH-TTY causes a veto on message printers
	 )
	(SETQ MODELIST 
	      '(LAMBDA (VGO) 
		  (COND (CCLOAD:FLUSH-TTY (ALARMCLOCK 'TIME -1))
			('T (COND ((AND (> (-$ (SETQ CCLOAD:TIME-TEMP (TIME)) 
					       CCLOAD:OTIME-TEMP) 
					   CCLOAD:CLOCK-EPSILON)
					(NOT CCLOAD:FLUSH-TTY))
				   (PRINC '|/
Using | TYO) 
				   (PRINC (*QUO (FIX (*QUO (- (RUNTIME) RUNTIME)
							   1.0E5)) 
						10.0) 
					  TYO)
				   (PRINC '| secs so far, out of | TYO)
				   (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0))
						10.0) 
					  TYO)
				   (PRINC '/  TYO)
				   (SETQ CCLOAD:TIME-TEMP (TIME))))
			    (COND ((> (-$ (SETQ CCLOAD:OTIME-TEMP CCLOAD:TIME-TEMP) TIME)
				      CCLOAD:CLOCK-SLOWDOWN) 
				   (SETQ CCLOAD:CLOCK-SLOWDOWN (*$ 2.0 CCLOAD:CLOCK-SLOWDOWN) 
					 CCLOAD:CLOCK-INTERVAL (* 2 CCLOAD:CLOCK-INTERVAL))))
			    (ALARMCLOCK 'TIME CCLOAD:CLOCK-INTERVAL)))))
	(SETQ ↑Q () )
     A  (PRINC '|/
PURE = (type ? for help) | TYO)
	(CLEAR-INPUT TYI)
	(COND ((MEMQ (SETQ PURE (CDR (ASSQ (READCH TYI () )
					   '((/1 . 1)  (/  . / ) (/? . /?) 
					     (/T . T) (/N . N ) (/X . XC) 
					     (/t . T) (/n . N ) (/x . XC) 
					     (/L . LAP) (/l . LAP) ))))
		   '(/? () ))
	       (AND (NULL PURE) (PRINC '|/
;Not acceptable, try again!/
|))
	       (AND (OR (STATUS FEATURE ITS)
			(STATUS FEATURE DEC20)
			(STATUS FEATURE SAIL))
		    (PRINC '|/
;    <space> 	Same as "1" below |))
	       (PRINC '|/
;    1	  Use the UUOLINKS table for function-to-function calls/
;	    and prepare for making code read-only ("pure" loading)/
;    N    Regular FASLOADing, fun-to-fun linkage by PUSHJ P,.../
;    T	  Pure loading, but no UUOLINKS/
| TYO)
	       (AND (STATUS FEATURE ITS) (PRINC '|/
;    L    Use COMPLR LAP file instead of COMPLR FASL, /
;	    ask again whether FASLAP is wanted/
;    X    Do (SSTATUS FEATURE XC), "pure" load using UUOLINKs /
;	    this is for creating an experimental compiler/
| TYO))
	       (GO A))
	      ((AND (EQ PURE '/ ) 
		    (OR (STATUS FEATURE ITS)
			(STATUS FEATURE DEC20)
			(STATUS FEATURE SAIL)))
	       (SETQ PURE (COND ((STATUS FEATURE ITS)
				 (CURSORPOS () 25.)
				 (PRINC '| 1 | TYO)
				 1)
				('T (PRINC '|1 |)
				    (COND ((STATUS FEATURE SAIL) 1)
					  (-1))))))
	      ((FIXP PURE) 
	       (SETQ PURE (COND ((AND (STATUS FEATURE DEC10)
				      (NOT (STATUS FEATURE SAIL)))
				 -1)
				(1))))
	      ((EQ PURE 'N) (SETQ PURE () ))
	      ((AND (MEMQ PURE '(XC LAP)) (STATUS FEATURE ITS)) 
		(SSTATUS FEATURE XC)
		(AND (EQ PURE 'XC) (SETQ PURE 1)))
	      ('T (PRINC '|/
You blew it!!  Try again| TYO) (GO A) ))
	(SETQ CCLOAD:OTIME-TEMP (TIME))
	(COND ((STATUS FEATURE ITS)
		(SSTATUS TTYIN 30. '(LAMBDA (VGO VGOL) (FUNCALL SLOTX)))
		(FUNCALL REGACS)))						;Sets up SLOTX, and starts ALARMCLOCK
	(AND (NOT CCLOAD:FLUSH-TTY)
	     (PRINC '|/
  (In LISP version | TYO)
	     (PRINC (STATUS LISPV) TYO)
	     (PRINC '|)|) TYO)
	(OR (NOT (STATUS FEATURE ITS))
	    (NOT (STATUS HACTR))
	    (VALRET (COND ((OR (NOT (FIXP PURE)) (STATUS FEATURE XC))
			   '|↔≠/:JCL/
XCOMPL≠≠J:VP |)
			  ('|↔≠/:JCL/
COMPLR≠≠J:VP |))))
	(SETQ LVRL '((LAMBDA (PURE)	 					;Loads LAP if necessary
			     (COND ((GET 'LAP 'FSUBR))
				   ((OR (AND (SETQ LVRL (GET 'LAP 'AUTOLOAD)) 
					     (PROBEF LVRL))
					(AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR)
								LVRL))
					     (PROBEF LVRL)))
				    (LOAD LVRL))
				   ('T  (PRINC '|/
;LAP FASL has not been found.  Please load it, and resume by <altmode>P |)
					(BREAK LOAD-LAP-FASL-PLEASE) ))
			     (PAGEBPORG)
			     (PURIFY 0 0 'BPORG)
			     (SETQ LVRL 'T))
			  (COND ((FIXP PURE) PURE) ('T)))
	      GL '((LAMBDA (PURE)
			   (COND ((STATUS FEATURE SAIL)
				  (HELP)
				  (AND (NOT CCLOAD:FLUSH-TTY)
				       (PRINC '|/
Loading gc-overflow-daemon |))
				  (LOAD '((DSK (AID RPG)) DEMON FAS))
				  (SETQ GC-OVERFLOW 'GC-OVERFLOW-DAEMON)
				  (REMPROP 'LET 'MACRO)
				  (REMPROP 'LET 'AUTOLOAD))
				 ('T (SETQ LET () )
				     (COND ((GET 'LET 'MACRO))
					   ((OR (AND (SETQ LVRL 
						      (GET 'LET 'AUTOLOAD)) 
						     (PROBEF LVRL))
						(AND (SETQ LVRL 
						      (MERGEF (LIST CCLOAD:DEV-DIR)
							      LVRL))
						     (PROBEF LVRL)))
					    (LOAD LVRL))
					   ('T (PRINC '|/
;LET FASL has not been found.  Please load it, and resume by <altmode>P |)
					       (BREAK LOAD-LET-FASL-PLEASE)))))
			   (COND ((GET '+INTERNAL-BACKQUOTE-MACRO 'SUBR))
				 ((OR (AND (SETQ LVRL (GET '+INTERNAL-BACKQUOTE-MACRO 'AUTOLOAD)) 
					   (PROBEF LVRL))
				      (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR)
							      LVRL))
					   (PROBEF LVRL)))
				  (LOAD LVRL))
				 ('T (PRINC '|/
;BACKQ FASL has not been found.  Please load it, and resume by <altmode>P |)
				     (BREAK LOAD-BACKQ-FASL-PLEASE) ))
			   (COND ((GET 'GETMIDASOP 'SUBR)) 
				 ((OR (AND (SETQ LVRL (GET 'GETMIDASOP 'AUTOLOAD)) 
					   (PROBEF LVRL))
				      (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR)
							      LVRL))
					   (PROBEF LVRL)))
				  (LOAD LVRL))
				 ('T (PRINC '|/
;GETMID FASL has not been found.  Please load it, and resume by <altmode>P |)
				     (BREAK LOAD-GETMID-FASL-PLEASE) )))
			(COND ((FIXP PURE) PURE) ('T))))
	(AND PURE (PAGEBPORG)) 
	(SETQ CCLOAD:DEV-DIR (COND ((STATUS FEATURE ITS) '(DSK COMLAP))
				   ((AND (STATUS FEATURE DEC20) 
					 (PROBEF '((PS MACLISP) COMPLR FASL)))
				    '(PS MACLISP))
				   ((STATUS FEATURE SAIL) '(DSK (MAC LSP)))
				   ((LIST 'DSK (STATUS UDIR)))))
      C (SETQ REGPDL (CONS CCLOAD:DEV-DIR '(COMPLR FASL)))
	(AND (NOT (STATUS FEATURE ITS))
	     (NOT (PROBEF REGPDL))
	     (PROG2 (PRINC '|/
;Please set up "CCLOAD:DEV-DIR" to a list of the device and directory /
;names to use for the loading the COMPLR and FASLAP FASL files/
| TYO)
		    (BREAK ULUZ)
		    (GO C)))
	(COND ((AND (NOT (EQ PURE 'LAP))
		    (OR (STATUS FEATURE ITS) (PROBEF REGPDL)))
		(COND ((NULL (GETSP (COND ((STATUS FEATURE SAIL) 51000.)
					  (44000.))))
		       (PRINC '|/
;Can't get enough Binary Program Space - You have lost badly!!/
|)
		       (BREAK ULUZ)
		       (GO C)))
		(EVAL GL)
		(AND (NOT CCLOAD:FLUSH-TTY) 
		     (PRINC '|/
Fazloading COMPLR FASL|) TYO)
		(LOAD REGPDL)
		(AND (NOT CCLOAD:FLUSH-TTY) 
		     (PRINC '|/
  (Compiler version number | TYO)
		     (PRINC COMPLRVERNO TYO)
		     (PRINC '|) | TYO))
		(PAGEBPORG))
	      ((STATUS FEATURE ITS)
		 (COND ((EQ PURE 'LAP) 
			(SSTATUS TTY 
				 (BOOLE 7 (CAR (SETQ UNSFLST (STATUS TTY))) 2←24.) 
				 (CADR UNSFLST))
			(PRINC '|/
FASLAP too?(Y or N) | TYO)
			(SETQ FLPDL (EQ (READCH () TYI) 'Y))
			(SSTATUS TTY (CAR UNSFLST) (CADR UNSFLST))))
		 (EVAL LVRL)
		 (EVAL GL)
		 (AND (NOT CCLOAD:FLUSH-TTY) (PRINC '|/
LAPping in COMPLR LAP | TYO))
		 (LOAD (CONS CCLOAD:DEV-DIR '(COMPLR LAP))) )
	      ('T (PRINC '|You Lose, Bunkie! Where is COMPLR file?|)
		  (BREAK CANT-FIND-COMPLR)
		  (GO C)))
	(COND (FLPDL 						;() if FASLAP not to be loaded
	        (SETQ REGPDL (CONS CCLOAD:DEV-DIR '(FASLAP FASL)))
	        (COND ((NOT (PROBEF REGPDL))
		       (PRINC '|/
You lose, Bunkie! Where is FASLAP file?|)
		       (BREAK CANT-FIND-FASLAP)
		       (GO C)))
		(AND (NOT CCLOAD:FLUSH-TTY) 
		     (PRINC '|/
Fazloading FASLAP FASL| TYO))
		(LOAD REGPDL)
		(AND (NOT CCLOAD:FLUSH-TTY) 
		     (PRINC '|/
  (FASLAP version number | TYO)
		     (PRINC FASLVERNO TYO)
		     (PRINC '|) | TYO))))
	(COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR '(MAKLAP FASL))))
	       (AND (NOT CCLOAD:FLUSH-TTY) 
		    (PRINC '|/
Fazloading MAKLAP FASL| TYO))
	       (LOAD GL)
	       (AND (NOT CCLOAD:FLUSH-TTY) 
		    (PRINC '|/
  (MAKLAP version number | TYO)
		    (PRINC MAKLAPVERNO TYO)
		    (PRINC '|) | TYO)))
	      ('T (PRINC '|You Lose, Bunkie! Where is MAKLAP file?|)
		  (BREAK CANT-FIND-MAKLAP) 
		  (GO C)))
	(COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR '(INITIA FASL))))
	       (AND (NOT CCLOAD:FLUSH-TTY) 
		    (PRINC '|/
Fazloading INITIA FASL| TYO))
	       (LOAD GL)
	       (AND (NOT CCLOAD:FLUSH-TTY) 
		    (PRINC '|/
  (INITIA version number | TYO)
		    (PRINC INITIAVERNO TYO)
		    (PRINC '|) | TYO)))
	      ('T (PRINC '|You Lose, Bunkie! Where is INITIA file?|)
		  (BREAK CANT-FIND-INITIA) 
		  (GO C)))
	(COND ((PROBEF (SETQ GL (LIST CCLOAD:DEV-DIR  
				      (MAKNAM (NCONC (EXPLODEN COMPLRVERNO)
						     '(C F)))
				      'FASL))) 
	       (AND (NOT CCLOAD:FLUSH-TTY) 
		    (PRINC '|/
Fazloading COMPLR fix file | TYO)
		    (PRINC (CADR GL) TYO))
	       (LOAD GL)))
	(COND ((PROBEF (SETQ GL (LIST CCLOAD:DEV-DIR  
				      (MAKNAM (NCONC (EXPLODEN COMPLRVERNO)
						     '(F F)))
				      'FASL))) 
	       (AND (NOT CCLOAD:FLUSH-TTY)
		    (PRINC '|/
Fazloading FASLAP fix file | TYO)
		    (PRINC (CADR GL) TYO))
	       (APPLY 'FASLOAD GL)))
	(COND ((STATUS FEATURE SAIL)
	       (AND (NOT CCLOAD:FLUSH-TTY)
		    (PRINC '|/
SAIL-specific loadings: |)
		    (PRINC '|/
  direct |))
	       (LOAD (COND ((STATUS FEATURE DDT)
			    '((DSK (MAC LSP)) DIRECT DFA))
			   ('((DSK (MAC LSP)) DIRECT FAS))))
	       (MAPC '(LAMBDA (GL) 
		       (AND (NOT CCLOAD:FLUSH-TTY)  (PRINC (CAR GL)))
		       (LOAD (CDR GL)))
		     '( (|/
  eread | (DSK (MAC LSP)) EREAD FAS)
			(|/
  macrodef | (DSK (MAC LSP)) MACROD FAS)
		        (|/
  require | (DSK (MAC LSP)) NCOREQ FAS)
			(|/
  loaded | (DSK (MAC LSP)) LOADED FAS)))
	       (SETQ SAIL-MORE-SYSFUNS 
		'(EREAD EOPEN ELOAD UGREAT1 REQUIRE EDIT CODE MAIL 
		  MACRODEF MACROBIND TRANS TRANSDEF 
		  %MATCH %CONTINUE %CONTINUE-MATCH %CHAR1 %MATCH-LOOKUP 
		  %%EXPAND%% %%EXPAND1%% %%%STRING%%% 
		  ))
	       (MAPC '(LAMBDA (X) 
			(COND ((GET (CAR X) 'AUTOLOAD)
			       (AND (CDDR X) (ARGS (CAR X) (CDDR X)))
			       (AND (CDR X) (PUTPROP (CAR X) (CDR X) 'FUNTYP-INFO))))) 
		     '((EREAD FSUBR) (EOPEN LSUBR 0 . 4) (ELOAD SUBR () . 1)
			(UGREAT1 SUBR  () . 1) (REQUIRE FSUBR) (EDIT FSUBR) 
			(CODE FSUBR) (MAIL FSUBR))) ))
  	(AND (NOT CCLOAD:FLUSH-TTY) (PRINC '|/
Initializing | TYO))
	(INITIALIZE)
	(AND (STATUS FEATURE ITS) (ALARMCLOCK 'TIME -1))
	(COND (CCLOAD:FLUSH-TTY)
	      ('T (PRINC '|/
Total Time = | TYO)
		  (PRINC (*QUO (FIX (*QUO (- (RUNTIME) RUNTIME) 1.0E5)) 
			       10.0) 
			 TYO)
		  (PRINC '| secs out of | TYO)
		  (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0)) 10.0) TYO)
		  (TERPRI)))
	(AND (NULL FXPDL) (SSTATUS NOFEATURE NOLDMSG))
	(SETQ ALARMCLOCK () ↑Q () ↑W () ))
  (AND (NOT (STATUS FASLOAD)) (INPUSH -1))		;Closes INIT file
  (AND (FILEP UREAD) (CLOSE UREAD))
  (AND (STATUS SSTATUS FLUSH) (SSTATUS FLUSH 'T))
  (SETQ PUTPROP CCLOAD:PUTPROP)
  (MAPC 'REMOB 
	(MAPCAR 'MAKUNBOUND 
		'(CCLOAD:CLOCK-SLOWDOWN CCLOAD:CLOCK-INTERVAL 
		  CCLOAD:CLOCK-EPSILON CCLOAD:TIME-TEMP CCLOAD:DEV-DIR 
		  CCLOAD:OTIME-TEMP CCLOAD:FLUSH-TTY CCLOAD:PUTPROP )))
  (GCTWA)
  (NORET () )
  (PRINC (COND ((STATUS FEATURE DEC20) '|Ready to SAVE as COMPLR.EXE.|)
	       ((NOT (STATUS FEATURE ITS))
		'|Ready to SSAVE as COMPLR.SAV (or .SHR,.LOW)/
Version number = |)
	       ((OR (NOT (FIXP PURE)) (STATUS FEATURE XC))
		'|Dumping eXperimentalCOMPLr on JONL;XC.DMP |)
	       ('T '|Dumping COMLAP;CL.DMP |))
	 TYO)
  (PRINC COMPLRVERNO TYO)
  (TERPRI)
  (COND ((AND (STATUS FEATURE ITS) PURE) (PAGEBPORG) (PURIFY 0 0 'BPORG)))
  (SETQ CCLOAD:PURE PURE PURE () )
  (COND ((STATUS FEATURE ITS) 
	 (CDUMP 0 (MAKNAM (NCONC (EXPLODEN (COND ((OR (NOT (FIXP CCLOAD:PURE))
						      (STATUS FEATURE XC))
						  '|DSK:JONL;XC.DMP |)
						 ('T '|COMLAP;CL.DMP |)))
				 (PROG2 (MAKUNBOUND 'CCLOAD:PURE)
					(EXPLODEN COMPLRVERNO))))))
	('T (MAKUNBOUND 'CCLOAD:PURE) 
	    (COND ((STATUS FEATURE SAIL) (CDUMP '|save sys:ncompl|))
		  ((CDUMP))) ))
)